home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol067 / filecab3.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-14  |  15.1 KB  |  374 lines
  1. 10 REM Program FILECAB3
  2. 20 REM Revised from FILECAB2 by Warren Cotton
  3. 30 REM Revision Date 05/27/84
  4. 99 '
  5. 1010 SCREEN 0,0,0:CLEAR
  6. 1020 KEY OFF: DEFINT A-Z: CLS
  7. 1030 OPEN "SCRN:" FOR OUTPUT AS #2
  8. 1040 DIM R$(21),AC(21),K(21,3),H$(21),RN$(21)
  9. 1050 H$(0)="REC #": Q$=CHR$(34): EH=0
  10. 1060 ON ERROR GOTO 1200: GOSUB 8000
  11. 1100 REM ===> BASENAME File Routines
  12. 1110 CLS:PRINT "SELECT FROM:":PRINT
  13. 1120 FOR J=1 TO NR: PRINT J" "R$(J): NEXT: PRINT
  14. 1130 PRINT J" CREATE A NEW DATA BASE"
  15. 1140 IF J>1 THEN PRINT J+1" DELETE A DATA BASE":PRINT
  16. 1150 INPUT"NUMBER";S: IF S<1 OR S>J+1 THEN GOSUB 9200: GOTO 1150
  17. 1160 IF S<J THEN DB$=R$(S): GOTO 1300
  18. 1170 ON S-NR GOTO 1220,1800
  19. 1200 RESUME 1210    'target of error
  20. 1210 ON ERROR GOTO 0
  21. 1220 IF J=0 THEN J=1
  22. 1230 PRINT: INPUT"NAME FOR NEW DATA BASE FILE: ",R$(J)
  23. 1240 IF LEN(R$(J))>8 THEN PRINT"MAX LENGTH 8 CHARACTERS": GOTO 1230
  24. 1250 FOR I=1 TO J-1: IF LEFT$(R$(I),5)<>LEFT$(R$(J),5) THEN NEXT: GOTO 1280
  25. 1260 PRINT"1ST 5 CHARACTERS DUPLICATE DATABASE "Q$+R$(I)+Q$"."
  26. 1270 PRINT"PLEASE CHOOSE ANOTHER NAME.": GOTO 1230
  27. 1280 DB$=R$(J): NR=J: GOSUB 8200
  28. 1300 ON ERROR GOTO 1510
  29. 1310 OPEN DB$+".HED" FOR INPUT AS #1
  30. 1315 ON ERROR GOTO 0
  31. 1320 INPUT #1,NH: FOR J=1 TO NH: INPUT #1,H$(J): NEXT: CLOSE #1
  32. 1330 MEM#=FRE(0): PRINT "AVAILABLE BYTES OF MEMORY ="FRE(0)
  33. 1340 PRINT: AVGFLEN=20: B=INT(MEM#/(AVGFLEN*NH))-10
  34. 1350 PRINT"DATABASE ";Q$+DB$+Q$;" HAS"NH"FIELDS.": PRINT
  35. 1355 PRINT"ASSUMING AN AVERAGE OF"AVGFLEN"CHARS/FIELD,"
  36. 1360 PRINT"MEMORY HAS ROOM FOR"B"RECORDS."
  37. 1370 DIM N$(B,NH),R(B): NR=0
  38. 1380 ON ERROR GOTO 1700
  39. 1400 OPEN DB$+".IND" FOR INPUT AS #1
  40. 1410 ON ERROR GOTO 0
  41. 1420 INPUT #1,NR: FOR J=1 TO NR: FOR I=1 TO NH
  42. 1430  LINE INPUT#1,N$(J,I)
  43. 1440 NEXT I,J: CLOSE #1: GOTO 2000
  44. 1500 REM ===> No field header file
  45. 1510 RESUME 1520   'target of error
  46. 1520 ON ERROR GOTO 0: NH=1
  47. 1530 CLS: PRINT "-RETURN- TO GO TO MAIN MENU"
  48. 1540 PRINT: GOSUB 1600: GOTO 1330
  49. 1600 REM ===> Accept field headers & write to file (.HED)
  50. 1610 PRINT"NAME FOR FIELD"NH;: INPUT": ",H$(NH)
  51. 1620 IF H$(NH)<>"" THEN NH=NH+1: IF NH<21 THEN 1610
  52. 1630 OPEN DB$+".HED" FOR OUTPUT AS #1
  53. 1640 NH=NH-1: PRINT #1,NH
  54. 1650 FOR J=1 TO NH: PRINT #1,H$(J): NEXT
  55. 1660 CLOSE #1: RETURN
  56. 1700 REM ===> No Database file
  57. 1710 RESUME 1720   'target of error
  58. 1720 ON ERROR GOTO 0
  59. 1730 PRINT: PRINT"DATABASE "Q$+DB$+Q$" ESTABLISHED"
  60. 1740 PRINT: INPUT"ARE YOU READY TO ENTER RECORDS";S$
  61. 1750 IF S$="Y" OR S$="y" THEN 6200 ELSE 2000
  62. 1800 REM ===> Delete a Data Base
  63. 1810 PRINT: INPUT"DATABASE # TO DELETE";S
  64. 1820 IF S<1 OR S>J-1 THEN GOSUB 9200: GOTO 1810
  65. 1830 CLS:LOCATE 9,1
  66. 1840 PRINT"READY TO DELETE "Q$+R$(S)+Q$".": PRINT
  67. 1850 PRINT"ONCE DELETED, THIS DATA CANNOT BE RECOVERED."
  68. 1860 INPUT"ARE YOU SURE YOU WANT TO DELETE IT (Y/N)";S$
  69. 1870 IF S$<>"Y" AND S$<>"y" THEN 1100
  70. 1880 ON ERROR GOTO 1920
  71. 1890 DB$=R$(S): GOSUB 4100
  72. 1900 FL$=DB$: FE$=".RPN": GOSUB 8300
  73. 1910 FE$=".RPT": FOR I=1 TO NN: FL$=LEFT$(DB$,5)+LEFT$(RN$(I),3): GOSUB 8300:        NEXT: GOTO 1930
  74. 1920 RESUME 1930   'target of error
  75. 1930 ON ERROR GOTO 0
  76. 1940 FL$=DB$: FE$=".IND": GOSUB 8300
  77. 1950 FE$=".HED": GOSUB 8300
  78. 1960 GOSUB 8000: IF NR=1 THEN FL$="BASENAME": FE$="": GOSUB 8300: GOTO 9400
  79. 1970 FOR I=S TO NR-1: R$(I)=R$(I+1): NEXT: NR=NR-1
  80. 1980 PRINT: PRINT"DELETION COMPLETED": GOSUB 8200: GOTO 1100
  81. 2000 REM ===> Main Menu
  82. 2010 CLS: PRINT"******* FILE CABINET *******": PRINT
  83. 2020 PRINT"CURRENT DATA BASE:    "DB$
  84. 2030 PRINT"CURRENT RECORD COUNT: "NR: PRINT
  85. 2040 PRINT"PRINTER ";: IF PF>0 THEN COLOR 23:PRINT"ON":COLOR 7: LM=50                ELSE PRINT"OFF": LM=21
  86. 2050 PRINT
  87. 2060 PRINT" 1  SELECT DATA BASE"
  88. 2070 PRINT" 2  SWITCH PRINTER ON/OFF"
  89. 2080 PRINT" 3  SEARCH DATA"
  90. 2090 PRINT" 4  LIST ALL RECORDS"
  91. 2100 PRINT" 5  REPORT"
  92. 2110 PRINT" 6  SORT DATA BASE"
  93. 2120 PRINT" 7  MODIFY DATA BASE"
  94. 2130 PRINT" 8  QUIT": PRINT: CD=0
  95. 2140 INPUT"NUMBER";S: IF S<1 OR S>8 THEN GOSUB 9200: GOTO 2140
  96. 2150 ON S GOTO 9400,2200,2400,2600,3000,5000,6000,9500
  97. 2200 IF PF THEN PF=0: CLOSE #2: OPEN "SCRN:" FOR OUTPUT AS #2: GOTO 2000
  98. 2210 CLS: PRINT"PRINTER OPTIONS:"
  99. 2220 PRINT" 1 =>  40 COLUMNS"
  100. 2230 PRINT" 2 =>  80 COLUMNS"
  101. 2240 PRINT" 3 => 132 COLUMNS": PRINT
  102. 2250 INPUT"WHICH";PF: IF PF<1 OR PF>3 THEN GOSUB 9200: GOTO 2250
  103. 2260 CLOSE #2: OPEN "LPT1:" FOR OUTPUT AS #2
  104. 2270 ON PF GOTO 2280,2300,2320
  105. 2280 PRINT #2,CHR$(18)
  106. 2290 PRINT"K": GOTO 2000
  107. 2300 PRINT #2,CHR$(18)
  108. 2310 PRINT"K80N": GOTO 2000
  109. 2320 PRINT #2,CHR$(15)    'compressed print
  110. 2330 PRINT"K132N": GOTO 2000
  111. 2400 REM ===> Search Data
  112. 2410 L=0
  113. 2420 CLS: PRINT"SEARCH ANY OF THE FOLLOWING FIELDS:": PRINT: GOSUB 7700
  114. 2430 INPUT"NUMBER";S: IF S<0 OR S>NH THEN GOSUB 9200: GOTO 2430
  115. 2440 PRINT: PRINT"ENTER THE ";H$(S);: INPUT" TO BE FOUND: ",S$
  116. 2450 CLS: L=0: IF S=0 THEN J=VAL(S$): GOSUB 2800: GOTO 2500
  117. 2460 FOR J=1 TO NR: N$(J,0)=STR$(J)
  118. 2470  I=INSTR(N$(J,S),S$): IF I>0 THEN GOSUB 2800
  119. 2490 NEXT J
  120. 2500 INPUT"SEARCH FINISHED -- MORE SEARCHES (Y/N)";L$
  121. 2510 IF L$="Y" OR L$="y" THEN 2420 ELSE 2000
  122. 2600 REM ===> List All Records
  123. 2610 L=0: CLS: IF PF THEN LPRINT CHR$(12)
  124. 2620 FOR J=1 TO NR: GOSUB 2800: NEXT J
  125. 2630 INPUT"END OF LIST   -RETURN- FOR MENU",L$: GOTO 2000
  126. 2800 REM ===> Print a Record
  127. 2810 PRINT #2,H$(0)": ";J
  128. 2820 FOR I=1 TO NH: PRINT #2,I" "H$(I)": "N$(J,I): NEXT
  129. 2830 PRINT #2,: L=L+NH+2: IF L+NH<LM THEN 2880
  130. 2835 IF PF THEN PRINT #2,CHR$(12)
  131. 2840 PRINT "-RETURN- TO CONTINUE; -ESC- FOR MAIN MENU";
  132. 2850 L$=INKEY$: IF L$="" THEN 2850
  133. 2860 IF L$=CHR$(27) THEN 2000 ELSE IF L$<>CHR$(13) THEN 2850
  134. 2870 CLS: L=0
  135. 2880 RETURN
  136. 3000 REM ===> Report
  137. 3010 T9=0: CLS: E=0
  138. 3020 FOR J=0 TO 21: FOR I=0 TO 3: K(J,I)=0: NEXT I,J
  139. 3030 FOR I=0 TO NH: AC(I)=0: NEXT: HC=0: GT=0
  140. 3040 ON E GOTO 3420
  141. 3050 REM Select Report
  142. 3060 ON ERROR GOTO 3210: GOSUB 4100
  143. 3070 CLS: PRINT"SELECT FROM:": PRINT
  144. 3080 FOR I=1 TO NN: PRINT I" "RN$(I): NEXT: PRINT
  145. 3090 PRINT I" CREATE A NEW REPORT FORMAT"
  146. 3100 PRINT I+1" DELETE A REPORT FORMAT": PRINT
  147. 3110 INPUT"NUMBER";S: IF S<1 OR S>I+1 THEN GOSUB 9200: GOTO 3110
  148. 3120 IF S=I+1 THEN 4000
  149. 3130 NN=S: IF S=I THEN 3260
  150. 3140 REM ===> Read Report Format File (.RPT)
  151. 3150 E=1: FL$=LEFT$(DB$,5)+LEFT$(RN$(NN),3)
  152. 3160 OPEN FL$+".RPT" FOR INPUT AS #1
  153. 3170 ON ERROR GOTO 0
  154. 3180 INPUT #1,RH
  155. 3190 FOR J=0 TO RH: INPUT #1,K(J,1),K(J,2),K(J,3): NEXT
  156. 3200 CLOSE #1: GOSUB 7700: GOTO 3420
  157. 3210 RESUME 3220   'target of error
  158. 3220 ON ERROR GOTO 0
  159. 3230 CLS: PRINT"NO REPORT FORMATS ARE STORED": PRINT: NN=1
  160. 3240 INPUT"CREATE A REPORT FORMAT (Y/N)";L$
  161. 3250 IF L$="Y" OR L$="y" THEN 3260 ELSE 2000
  162. 3260 GOSUB 7700
  163. 3270 INPUT"HOW MANY FIELDS";RH
  164. 3280 IF RH<1 OR RH>NH+1 THEN GOSUB 9200: GOTO 3270
  165. 3290 IF E=0 THEN RN$(NN)="PRESENT"
  166. 3300 FOR J=1 TO RH
  167. 3310  PRINT"FIELD # FOR POSITION"J;: INPUT": ",K(J,1)
  168. 3320  IF K(J,1)<0 OR K(J,1)>NH THEN 3310
  169. 3330  PRINT"STARTING COLUMN FOR ";H$(K(J,1));: INPUT K(J,2)
  170. 3340  IF K(J,2)<0 OR K(J,2)>255 THEN 3330
  171. 3350  PRINT"ACCUM TOTAL ON ";H$(K(J,1));: INPUT" (Y/N)";L$
  172. 3360  IF L$="Y" OR L$="y" THEN K(J,3)=1: K(0,3)=1
  173. 3370 NEXT J
  174. 3380 IF K(0,3)=0 THEN 3420
  175. 3390 INPUT"STARTING COLUMN FOR TOTAL";K(0,2)
  176. 3400 IF K(0,2)=0 THEN K(0,3)=0: T9=1: GOTO 3420
  177. 3410 IF K(0,2)<0 OR K(0,2)>131 THEN GOSUB 9200: GOTO 3390
  178. 3420 PRINT
  179. 3430 INPUT"SELECT RECORDS BY WHICH FIELD #";S
  180. 3440 IF S=0 THEN S$="@": GOTO 3510
  181. 3450 IF S>NH THEN BEEP: GOSUB 9200: GOTO 3430
  182. 3460 INPUT"ENTER 'AND' FIELD # (0 IF NONE): ",X
  183. 3470 IF X>NH THEN BEEP: GOSUB 9200: GOTO 3460
  184. 3480 PRINT: PRINT"'@' WILL SELECT ALL RECORDS:"
  185. 3490 PRINT"SELECT RECORDS FOR "H$(S);: INPUT"= ";S$
  186. 3500 IF X=0 THEN X$="@" ELSE PRINT "'AND' "H$(X);: INPUT"= ";X$
  187. 3510 IF PF THEN PRINT #2,CHR$(12)
  188. 3520 GOSUB 3950: FOR J=1 TO NR
  189. 3530  N$(J,0)=STR$(J)
  190. 3540  IF S$="@" THEN 3580
  191. 3550  IF LEFT$(N$(J,S),LEN(S$))<>S$ THEN 3590
  192. 3560  IF X$="@" THEN 3580
  193. 3570  IF LEFT$(N$(J,X),LEN(X$))<>X$ THEN 3590
  194. 3580  GOSUB 3700
  195. 3590  IF L>LM THEN GOSUB 3900
  196. 3600 NEXT J
  197. 3610 ON T9 GOSUB 3800
  198. 3620 ON E GOTO 3650
  199. 3630 PRINT:INPUT"SAVE THE FORMAT FOR THIS REPORT (Y/N)";L$
  200. 3640 IF L$="Y" OR L$="y" THEN E=1: GOSUB 4400
  201. 3650 PRINT: PRINT "MORE REPORTS WITH THE "RN$(NN);: INPUT" FORMAT (Y/N)";L$
  202. 3660 IF L$="Y" OR L$="y" THEN GOSUB 7700: E=1: GOTO 3030
  203. 3670 GOTO 2000
  204. 3700 REM Subroutine to print the report
  205. 3710 FOR I=1 TO RH: PRINT #2,TAB(K(I,2)) N$(J,K(I,1));
  206. 3720  IF K(I,3)=1 THEN V=VAL(N$(J,K(I,1))): AC(I)=AC(I)+V: HC=HC+V
  207. 3730 NEXT I
  208. 3740 IF K(0,3)=1 THEN IF HC<>0 THEN PRINT #2,TAB(K(0,2)) HC;: GT=GT+HC: HC=0
  209. 3750 L=L+1: PRINT #2,: RETURN
  210. 3800 REM Subroutine to print report totals
  211. 3810 FOR I=1 TO 39+((PF>1)*39): PRINT #2,"-";: NEXT: PRINT #2,
  212. 3820 FOR I=1 TO RH
  213. 3830  IF AC(I)>0 THEN PRINT #2,TAB(K(I,2)) AC(I);
  214. 3840 NEXT I
  215. 3850 IF GT<>0 THEN PRINT #2,TAB(K(0,2)) GT;
  216. 3860 PRINT #2,: RETURN
  217. 3900 REM Subroutine to print report header
  218. 3910 IF PF>0 THEN PRINT #2,CHR$(12): GOTO 3950
  219. 3920 PRINT: PRINT "-RETURN- TO CONTINUE; -ESC- TO END REPORT";
  220. 3930 L$=INKEY$:IF L$="" THEN 3930
  221. 3940 IF L$=CHR$(27) THEN 3620 ELSE IF L$<>CHR$(13) THEN 3930
  222. 3950 CLS: PRINT #2,RN$(NN)" REPORT FOR "H$(S)": "S$;
  223. 3960 IF X$="@" THEN PRINT #2, ELSE PRINT #2," AND "H$(X)": "X$
  224. 3970 FOR I=1 TO RH: PRINT #2,TAB(K(I,2)) H$(K(I,1));: NEXT
  225. 3980 IF K(0,3)=1 THEN PRINT #2,TAB(K(0,2)) "TOTAL";
  226. 3990 PRINT #2,: PRINT #2,: L=4: RETURN
  227. 4000 REM ===> Delete a Report Format
  228. 4010 PRINT: INPUT"DELETE WHICH FORMAT (0 TO ABORT DELETION)";S
  229. 4020 IF S<0 OR S>NN THEN GOSUB 9200: GOTO 4010
  230. 4030 IF S=0 THEN 2000
  231. 4040 FL$=LEFT$(DB$,5)+LEFT$(RN$(S),3):FE$=".RPT": GOSUB 8300
  232. 4050 FE$=".RPN": IF NN=1 THEN FL$=DB$: GOSUB 8300: GOTO 2000
  233. 4060 FOR I=S TO NN-1: RN$(I)=RN$(I+1): NEXT
  234. 4070 NN=NN-1: GOSUB 4100: GOTO 2000
  235. 4100 REM ===> Read Report Name File (.RPN)
  236. 4110 OPEN DB$+".RPN" FOR INPUT AS #1
  237. 4120 ON ERROR GOTO 0
  238. 4130 INPUT #1,NN: FOR J=1 TO NN: INPUT #1,RN$(J): NEXT
  239. 4140 CLOSE #1: RETURN
  240. 4200 REM ===> Save Report Name File (.RPN)
  241. 4210 OPEN DB$+".RPN" FOR OUTPUT AS #1
  242. 4220 PRINT #1,NN
  243. 4230 FOR J=1 TO NN: PRINT #1,RN$(J): NEXT
  244. 4240 CLOSE #1: RETURN
  245. 4400 REM ===> Save Report Format File
  246. 4410 PRINT: INPUT"REPORT FORMAT NAME";RN$(NN)
  247. 4420 FOR I=1 TO NN-1: IF LEFT$(RN$(I),3)<>LEFT$(RN$(NN),3) THEN NEXT: GOTO 4450
  248. 4430 PRINT"1ST 3 CHARACTERS DUPLICATE ANOTHER FORMAT"
  249. 4440 PRINT"PLEASE CHOOSE ANOTHER NAME": GOTO 4410
  250. 4450 FL$=LEFT$(DB$,5)+LEFT$(RN$(NN),3)
  251. 4460 OPEN FL$+".RPT" FOR OUTPUT AS #1: PRINT #1,RH
  252. 4470 FOR J=0 TO RH: PRINT #1,K(J,1);",";K(J,2);",";K(J,3): NEXT
  253. 4480 CLOSE #1: GOSUB 4200: RETURN
  254. 5000 REM ===> Sort Data Base
  255. 5010 CLS: MF=1: GOSUB 7700
  256. 5020 INPUT"SORT ON WHICH FIELD #";S: IF S<1 OR S>NH THEN 5020
  257. 5030 PRINT:PRINT" 1  SORT ALPHA"
  258. 5040 PRINT" 2  SORT NUMERIC": PRINT
  259. 5050 INPUT"WHICH";L: IF L<1 OR L>2 THEN 5050
  260. 5060 PRINT: PRINT "SORTING ..."
  261. 5070 FOR I=1 TO NR: R(I)=0: NEXT
  262. 5080 FOR I=1 TO NR: FOR J=1 TO NR
  263. 5090  ON L GOTO 5100,5120
  264. 5100  IF N$(I,S)>=N$(J,S) THEN R(I)=R(I)+1
  265. 5110  GOTO 5130
  266. 5120  IF VAL(N$(I,S))>=VAL(N$(J,S)) THEN R(I)=R(I)+1
  267. 5130 NEXT J,I
  268. 5140 PRINT "SORT PHASE 1 FINISHED"
  269. 5150 FOR I=NR TO 1 STEP -1:FOR J=NR TO 1 STEP -1
  270. 5160  IF I<>J THEN IF R(I)=R(J) THEN R(J)=R(J)-1
  271. 5170 NEXT J,I
  272. 5180 PRINT"SORT PHASE 2 FINISHED": J=1
  273. 5190 IF R(J)=J THEN J=J+1:GOTO 5190
  274. 5200 IF J>=NR THEN 5230
  275. 5210 FOR I=1 TO NH: SWAP N$(R(J),I),N$(J,I): NEXT
  276. 5220 SWAP R(R(J)),R(J): GOTO 5190
  277. 5230 BEEP: PRINT"SAVE THE ";DB$;" FILE SORTED BY ";H$(S);: INPUT L$
  278. 5240 IF L$="Y" OR L$="y" THEN GOSUB 8100
  279. 5250 GOTO 2000
  280. 6000 REM ===> Modify Data Base sub-menu
  281. 6010 CLS: PRINT"****  MODIFY DATA BASE  ****": PRINT
  282. 6020 PRINT"CURRENT DATA BASE:    "DB$
  283. 6030 PRINT"CURRENT RECORD COUNT: "NR
  284. 6040 PRINT"ROOM FOR"B - NR"MORE RECORDS": PRINT
  285. 6050 PRINT" 1  ENTER RECORDS"
  286. 6060 PRINT" 2  CHANGE DATA"
  287. 6070 PRINT" 3  DELETE RECORDS"
  288. 6080 PRINT" 4  EXPAND DATA BASE (ADD HEADERS)"
  289. 6090 PRINT" 5  RETURN TO MAIN MENU": PRINT
  290. 6100 INPUT"NUMBER";S: IF S<1 OR S>5 THEN GOSUB 9200: GOTO 6100
  291. 6110 ON S GOTO 6200,6400,6600,6700,6900
  292. 6200 REM ===> Enter Records
  293. 6210 CLS
  294. 6220 NR=NR+1: PRINT"ENTERING RECORD #"NR: PRINT
  295. 6230 FOR I=1 TO NH: PRINT H$(I)": ";: I$=""
  296. 6240  LINE INPUT I$: IF LEFT$(I$,1)=CHR$(3) THEN STOP
  297. 6250  IF I$="*" AND NR>1 THEN N$(NR,I)=N$(NR-1,I) ELSE N$(NR,I)=I$
  298. 6260 NEXT I: PRINT: CD=1
  299. 6270 INPUT"ENTER ANOTHER RECORD (Y/N)";L$
  300. 6280 IF L$="Y" OR L$="y" THEN 6220 ELSE 6000
  301. 6400 REM ===> Change Data
  302. 6410 PRINT: INPUT"REC # TO BE CHANGED";J
  303. 6420 CLS: PRINT H$(0);": ";J
  304. 6430 FOR I=1 TO NH: PRINT I" "H$(I)": "N$(J,I): NEXT: PRINT
  305. 6440 INPUT"FIELD NUMBER TO BE CHANGED (0 FOR NO CHANGE)";S
  306. 6450 IF S<1 THEN 6500 ELSE IF S>NH THEN GOSUB 9200: GOTO 6440
  307. 6460 PRINT: PRINT"FROM ";H$(S);": ";N$(J,S)
  308. 6470 PRINT" TO  ";H$(S);": ";
  309. 6480 I$="": LINE INPUT I$: CD=1
  310. 6490 IF I$="*" AND J>1 THEN N$(J,S)=N$(J-1,S) ELSE N$(J,S)=I$
  311. 6500 PRINT: PRINT"(-ESC- TO END CHANGES, -RETURN- FOR NEXT HIGHER REC #)"
  312. 6510 PRINT"NEXT REC # TO CHANGE? ";: LOCATE ,,1: A$=""
  313. 6520 L$=INKEY$: IF L$="" THEN 6520
  314. 6530 IF L$=CHR$(27) THEN 6000
  315. 6540 IF L$=CHR$(13) THEN IF LEN(A$)=0 THEN J=J+1: GOTO 6420                          ELSE J=VAL(A$): GOTO 6420
  316. 6550 IF L$=CHR$(8) THEN LOCATE ,POS(0)-1: PRINT" ";: LOCATE ,POS(0)-1,1:             IF LEN(A$)>0 THEN A$=LEFT$(A$,LEN(A$)-1): GOTO 6520 ELSE 6520
  317. 6560 IF ASC(L$)>=48 AND ASC(L$)<=57 THEN PRINT L$;: A$=A$+L$: ELSE BEEP
  318. 6570 GOTO 6520
  319. 6600 REM ===> Delete Records
  320. 6605 CLS
  321. 6610 INPUT"ENTER REC # TO DELETE (-RETURN- TO END DELETION): ",DR
  322. 6620 IF DR<1 THEN 6000 ELSE IF DR>NR THEN GOSUB 9200: GOTO 6610
  323. 6630 PRINT: PRINT H$(0);": ";DR
  324. 6640 FOR I=1 TO NH: PRINT I" "H$(I)": "N$(DR,I): NEXT
  325. 6650 PRINT: INPUT"DELETE THIS RECORD (Y/N)";L$
  326. 6660 IF L$="Y" OR L$="y" THEN 6670 ELSE PRINT: GOTO 6610
  327. 6670 FOR J=DR TO NR-1: FOR I=1 TO NH
  328. 6680  N$(J,I)=N$(J+1,I): NEXT I,J: NR=NR-1: CD=1
  329. 6690 PRINT: PRINT">>> RECORD NUMBER"DR"DELETED <<<": PRINT: GOTO 6610
  330. 6700 REM ===> Expand data base
  331. 6710 CLS: PRINT"CURRENT FIELDS ARE:": PRINT
  332. 6720 FOR I=1 TO NH: PRINT I;" ";H$(I): NEXT
  333. 6730 PRINT: PRINT"ENTER NEW HEADERS   -RETURN- WHEN FINISHED"
  334. 6740 PH=NH: NH=NH+1: PRINT: GOSUB 1600
  335. 6750 EH=1: GOSUB 8100: PRINT: PRINT"EXPANSION COMPLETED"
  336. 6760 EH=O: ERASE N$,R: GOTO 1330
  337. 6900 REM ===> Return to Main Menu
  338. 6910 IF CD=1 THEN GOSUB 8100
  339. 6920 GOTO 2000
  340. 7700 REM ===> Sub-Menu of Field Headers
  341. 7710 PRINT "SELECT FROM:":PRINT
  342. 7720 IF MF=0 THEN PRINT MF;" ";H$(0)
  343. 7730 FOR I=1 TO NH: PRINT I;" ";H$(I): NEXT
  344. 7740 PRINT: MF=0: RETURN
  345. 8000 REM ===> Read Basename File
  346. 8020 OPEN "BASENAME" FOR INPUT AS #1
  347. 8030 ON ERROR GOTO 0
  348. 8040 INPUT #1,NR: FOR J=1 TO NR: INPUT #1,R$(J): NEXT
  349. 8050 CLOSE #1: RETURN
  350. 8100 REM ===> Write Database File (.IND)
  351. 8110 OPEN DB$+".IND" FOR OUTPUT AS #1
  352. 8120 PRINT #1,NR
  353. 8130 FOR J=1 TO NR: FOR I=1 TO NH
  354. 8140  IF EH=1 AND I>PH THEN PRINT #1,"" ELSE PRINT #1,N$(J,I)
  355. 8150 NEXT I,J: CLOSE #1: RETURN
  356. 8200 REM ===> Write Basename File
  357. 8220 OPEN "BASENAME" FOR OUTPUT AS #1
  358. 8230 PRINT #1,NR
  359. 8240 FOR J=1 TO NR: PRINT #1,R$(J): NEXT
  360. 8250 CLOSE #1: RETURN
  361. 8300 REM ===> Delete a File
  362. 8310 PRINT"FILE "FL$+FE$;
  363. 8320 ON ERROR GOTO 8340
  364. 8330 KILL FL$+FE$: PRINT" DELETED": GOTO 8350
  365. 8340 PRINT" NOT FOUND": RESUME 8350   'target of error
  366. 8350 ON ERROR GOTO 0: RETURN
  367. 9200 REM ===> Subroutine to erase a line
  368. 9210 RWLC=CSRLIN-1: LOCATE RWLC,1: PRINT SPC(50);
  369. 9220 LOCATE RWLC,1: BEEP: RETURN
  370. 9400 CLOSE: RUN
  371. 9500 END
  372. 9999 REM ===> Dummy line for RENUM
  373. OCATE RWLC,1: PRINT SPC(50);
  374. 9220 LOCATE